PC Users 1999 May/Cd Pc Users extra 20 mayo 1999.iso/Internet/MAIN.FRM

Visual Basic Form | 1999-04-30 | 23.7 KB | 740 lines

VERSION 2.00
Begin Form frmMain
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   8775
   ClientLeft      =   960
   ClientTop       =   1875
   ClientWidth     =   11070
   ControlBox      =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Arial"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   ForeColor       =   &H00000000&
   Height          =   9180
   Icon            =   MAIN.FRX:0000
   Left            =   900
   LinkTopic       =   "Form1"
   ScaleHeight     =   585
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   738
   Top             =   1530
   Width           =   11190
   WindowState     =   2  'Maximized
   Begin PictureBox PicPres
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   1860
      Left            =   285
      ScaleHeight     =   124
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   145
      TabIndex        =   14
      Top             =   255
      Visible         =   0   'False
      Width           =   2175
   End
   Begin PictureBox PicPrin
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      Height          =   8520
      Left            =   960
      ScaleHeight     =   566
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   640
      TabIndex        =   0
      Top             =   60
      Visible         =   0   'False
      Width           =   9630
      Begin FileListBox FileArch
         Height          =   810
         Left            =   8550
         System          =   -1  'True
         TabIndex        =   9
         Top             =   7260
         Visible         =   0   'False
         Width           =   1050
      End
      Begin PictureBox PicDesc
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00C00000&
         Height          =   3495
         Left            =   5565
         ScaleHeight     =   231
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   229
         TabIndex        =   3
         Top             =   2655
         Width           =   3465
         Begin Label Dummy
            Caption         =   "PicDesc"
            Height          =   195
            Index           =   0
            Left            =   60
            TabIndex        =   6
            Top             =   75
            Visible         =   0   'False
            Width           =   885
         End
      End
      Begin PictureBox PicDat
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FFFFFF&
         Height          =   2940
         Left            =   735
         ScaleHeight     =   194
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   221
         TabIndex        =   2
         Top             =   3105
         Width           =   3345
         Begin Label Dummy
            Caption         =   "PicDat"
            Height          =   195
            Index           =   1
            Left            =   0
            TabIndex        =   7
            Top             =   0
            Visible         =   0   'False
            Width           =   885
         End
      End
      Begin Label Categoria
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   315
         Index           =   4
         Left            =   7245
         TabIndex        =   13
         Top             =   1800
         Width           =   1800
      End
      Begin Label Categoria
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   315
         Index           =   3
         Left            =   6060
         TabIndex        =   12
         Top             =   1800
         Width           =   1095
      End
      Begin Label Categoria
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   315
         Index           =   2
         Left            =   3810
         TabIndex        =   11
         Top             =   1800
         Width           =   2055
      End
      Begin Label LblTam
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Tama
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Left            =   4425
         TabIndex        =   10
         Top             =   7710
         Width           =   2445
      End
      Begin Label Categoria
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   315
         Index           =   1
         Left            =   2820
         TabIndex        =   8
         Top             =   1800
         Width           =   780
      End
      Begin Image ImgFoto
         Height          =   315
         Left            =   4620
         Top             =   8085
         Width           =   2085
      End
      Begin Image BotCopD
         Height          =   315
         Left            =   1485
         Picture         =   MAIN.FRX:0302
         Top             =   7260
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Image BotExeD
         Height          =   315
         Left            =   2925
         Picture         =   MAIN.FRX:106E
         Top             =   7260
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Image BotInstD
         Height          =   315
         Left            =   75
         Picture         =   MAIN.FRX:1DDA
         Top             =   7260
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Label LblDesc
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Descripcion"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Left            =   4425
         TabIndex        =   1
         Top             =   7335
         Width           =   2520
      End
      Begin Label LblTit
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Titulo"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H000000C0&
         Height          =   360
         Left            =   765
         TabIndex        =   4
         Top             =   2625
         Width           =   3315
      End
      Begin Label Categoria
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Tahoma"
         FontSize        =   10.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   315
         Index           =   0
         Left            =   645
         TabIndex        =   5
         Top             =   1800
         Width           =   1995
      End
      Begin Image BotDn
         Height          =   330
         Left            =   4410
         Top             =   4560
         Width           =   375
      End
      Begin Image BotUp
         Height          =   345
         Left            =   4425
         Top             =   3900
         Width           =   375
      End
      Begin Image BotTriD
         Height          =   315
         Left            =   7170
         Picture         =   MAIN.FRX:2B46
         Top             =   7410
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Image BotTriU
         Height          =   315
         Left            =   7740
         Picture         =   MAIN.FRX:38B2
         Top             =   6525
         Width           =   1650
      End
      Begin Image BotInst
         Height          =   315
         Left            =   1575
         Picture         =   MAIN.FRX:461E
         Top             =   6525
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Image BotExe
         Height          =   315
         Left            =   2550
         Picture         =   MAIN.FRX:538A
         Top             =   6525
         Visible         =   0   'False
         Width           =   1650
      End
      Begin Image BotCop
         Height          =   315
         Left            =   645
         Picture         =   MAIN.FRX:60F6
         Top             =   6525
         Visible         =   0   'False
         Width           =   1650
      End
   End
Dim CDat As Integer
Dim A_DAT As Integer
Dim C_Norm As Long
Dim C_Hlite As Long
Dim CLIN%
Dim Prim%
Dim XI%, YI%, ANI%, ALI%
Dim WTexto$
Sub Accion (Cual As Integer)
    Dim Opcion%, WTam$, Aux$, T$, P&
    Dim Went$
    Went = Chr(13) + Chr(10)
    Opcion = 0
    Select Case Opcion
        Case 0
            'Esto pone la descripcion
            T$ = VDatos(Cual).Path
            Aux = Aux + "ESPACIO EN DISCO: " + Trim$(VDatos(Cual).Tamanio) + " MB" + Went
            Aux = Aux + "ENTORNO: " + VDatos(Cual).Entorno + Went
            Aux = Aux + "DESCRIPCION: " + Went
            Aux = Aux + VDatos(Cual).Desc
            PrintPic Aux, PicDesc, 0, 0, 0, 0
        Case 1
            'Pone una Imagen
            ImgFoto.Picture = LoadPicture(Wpath + "BMP\" + Trim(VDatos(Cual).Path) + ".BMP")
            ImgFoto.Visible = True
        Case 2
            'Ajusta una Imagen
            AjustaImg ImgFoto, Wpath + VCat(CatActual).DAT + "\" + Trim(VDatos(Cual).Path), XI, YI, ANI, ALI
            Aux$ = ImgFoto.Tag
            Do While Aux <> ""
                P = InStr(Aux, "/")
                If P = 0 Then
                    T = Aux
                    Aux = ""
                Else
                    T$ = Left(Aux, P - 1)
                    Aux = Mid(Aux, P + 1)
                End If
                P = Val(Mid(T, 3))
                Select Case Left(T, 1)
                    Case "T"
                        WTam = WTam + "Tama
o: " + Format(P / 1024, "#,###") + " Kb - "
                    Case "W"
                        WTam = WTam + "Ancho: " + Format(P, "####") + " pixels "
                    Case "H"
                        WTam = WTam + "Alto: " + Format(P, "####") + " pixels - "
                End Select
            Loop
            LblTam.Caption = WTam
            ImgFoto.Visible = True
        Case 3
    End Select
End Sub
Sub BotCop_Click ()
    Dim Ori$, Dest$
    Dim SWPath$, Q$
    Ori$ = VDatos(A_DAT).Path
    If InStr(Ori, ".") <> 0 Then
        L = Len(Ori)
        For X = L To 1 Step -1
            If Mid$(Ori, X, 1) = "\" Then
                Ori = Left$(Ori, X - 1)
                Exit For
            End If
        Next
    End If
    L = InStr(Ori, "\")
    Dest = Mid$(Ori, L + 1)
    Dest = "C:\" + Dest
    SWPath = VCat(CatActual).DAT
    Q$ = Wpath + SWPath
    Origen = Q + "\" + Ori
    Origen = ValidPath(Origen)
    Destino = Dest
    'Destino = ""
    FrmInst.Show 1
End Sub
Sub BotCop_MouseDown (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotCopD.Visible = True
End Sub
Sub BotCop_MouseUp (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotCopD.Visible = False
    BotCop_Click
End Sub
Sub BotDn_Click ()
    If Prim + CLIN <= CDat Then
        Prim = Prim + CLIN
    End If
    PicDat.Refresh
End Sub
Sub BotExe_Click ()
    Dim QueHago%, Q$, SWPath$, Nom$
    QueHago = 0
    Select Case QueHago
        Case 0
            'Ejecuta un EXE
            Dim Exe$, Mensa$, A%
            Mensa = "Usted est
 por ejecutar el siguiente programa:" + Chr(13) + Chr(10)
            Mensa = Mensa + UCase$(VDatos(A_DAT).Titulo) + Chr(13) + Chr(10)
            Mensa = Mensa + "Cuando finalice la ejecuci
n, presione ALT-TAB varias veces para regresar este programa"
            If MsgBox(Mensa, 1, "Ejecutar") = 1 Then
                SWPath = VCat(CatActual).DAT
                Q$ = Wpath + SWPath
                Nom = Q + "\"
                Nom = ValidPath(Nom)
                Nom = Nom + VDatos(A_DAT).Path
                Exe$ = Nom
                A% = Shell(Exe$, 1)
            End If
    End Select
End Sub
Sub BotExe_MouseDown (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotExeD.Visible = True
End Sub
Sub BotExe_MouseUp (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotExeD.Visible = False
    BotExe_Click
End Sub
Sub BotInst_Click ()
    Dim Exe$, Nom$, SWPath, Q$
    Dim Mensa$, A%
    Dim QueHago%
    QueHago = 0
    Select Case QueHago
        Case 0
            'Instala un exe
            Mensa = "Usted est
 por instalar el siguiente programa:" + Chr(13) + Chr(10)
            Mensa = Mensa + UCase$(VDatos(A_DAT).Titulo) + Chr(13) + Chr(10)
            Mensa = Mensa + "Cuando finalice la instalaci
n, presione ALT-TAB hasta encontrar este programa"
            If MsgBox(Mensa, 1, "Instalar") = 1 Then
                SWPath = VCat(CatActual).DAT
                Q$ = Wpath + SWPath
                Nom = Q + "\"
                Nom = ValidPath(Nom)
                Nom = Nom + VDatos(A_DAT).Path
                Exe$ = Nom
                A% = Shell(Exe$, 1)
            End If
        Case 1
            'Instala un Font
            Exe$ = Wpath + "TTF\" + VDatos(A_DAT).Path + ".TTF"
            Nom$ = VDatos(A_DAT).Titulo
            A = CheckFont(Exe$, Nom$)
            If A Then
                Mensa = "La tipograf
a " + VDatos(A_DAT).Titulo + " ha sido instalada en su sistema. A partir de ahora, usted puede utilizarla con cualquier aplicaci
n de Windows."
            Else
                Mensa = "Se ha producido un error al instalar la tipograf
a " + VDatos(A_DAT).Titulo + ". Puede ocurrir que ya exista una tipografia con ese nombre en su sistema. De no ser asi, si usted usa Windows 95 puede instalar este font copiando en archivo " + Wpath + "TTF\" + VDatos(A_DAT).Path + ".ttf" + " a la carpeta de Fonts de sus sistema (normalmente, WINDOWS\FONTS). Si usa Windows 3.1, puede instalarla desde el Panel de Control."
            End If
            MsgBox Mensa, , "Instalaci
    End Select
End Sub
Sub BotInst_MouseDown (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotInstD.Visible = True
End Sub
Sub BotInst_MouseUp (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotInstD.Visible = False
    BotInst_Click
End Sub
Sub BotTriU_Click ()
    PlaySndNS Wpath + "..\Mpop.wav"
    End
End Sub
Sub BotTriU_MouseDown (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotTriD.Visible = True
End Sub
Sub BotTriU_MouseUp (Button As Integer, Shift As Integer, X As Single, y As Single)
    BotTriD.Visible = False
    BotTriU_Click
End Sub
Sub BotUp_Click ()
    Prim = Prim - CLIN
    If Prim < 1 Then
        Prim = 1
    End If
    PicDat.Refresh
End Sub
Sub CargaCat ()
    Dim N%
    Dim A$, B$, C$, D$, E$, Q$
    Open Wpath + "categ.txt" For Input As #1
    N = 0
    ReDim VCat(0)
    Do While Not EOF(1)
        Line Input #1, A$
        Line Input #1, B$
        If Not EOF(1) Then
            Line Input #1, D$
        End If
        A$ = UCase(A$)
        ReDim Preserve VCat(N)
        VCat(N%).Titulo = A$
        VCat(N%).DAT = B$
        Categoria(N).Caption = A$
        N% = N% + 1
    Loop
    Close #1
    CANTCAT = N - 1
End Sub
Sub CargaDat (WCual As Integer)
    Dim N%, Cual$, SWPath$
    Dim A$, B$, C$, D$, E$, F$, Q$
    Dim Opcion%
    Opcion = 0
    Select Case Opcion
        Case 0  'Lee un DAT del directorio DAT
            Categoria(WCual).ForeColor = C_Hlite
            SWPath = VCat(WCual).Desc
            Cual = VCat(WCual).DAT
            ReDim VDatos(0)
            Q$ = Wpath + SWPath + "DAT\" + Cual + ".dat"
            Open Q$ For Input As #1
            N = 0
            Do While Not EOF(1)
                'Esto cambia segun el tipo de DAT
                N% = N% + 1
                ReDim Preserve VDatos(N%)
                'DCsecial 1#
                'Plugins para Photoshop que realizan trabajos de fade, realizan fondos y recomponen im
genes.
                'WINDOWS 3.1 y 95
                'DC1\
                'C
                Line Input #1, A$
                Line Input #1, B$
                Line Input #1, C$
                Line Input #1, D$
                Line Input #1, E$
                Line Input #1, F$
                If Not EOF(1) Then
                    Line Input #1, Q$
                End If
                VDatos(N%).Titulo = A$
                VDatos(N%).Desc = B$
                'C$ = StrTr(C$, "WINDOWS", "WIN")
                VDatos(N%).Entorno = C$
                If Left$(D$, 1) = "\" Then D$ = Mid(D$, 2)
                If Right$(D$, 1) = "\" Then D$ = Left(D$, Len(D$) - 1)
                VDatos(N%).Path = D$
                VDatos(N%).Tamanio = E$
                VDatos(N%).Accion = UCase$(F$)
            Loop
            Close #1
        Case 1  'Todos los archivos de un directorio
            FileArch.Path = Wpath + VCat(WCual).DAT
            FileArch.Pattern = "*.*"
            FileArch.Refresh
            For N = 1 To FileArch.ListCount
                ReDim Preserve VDatos(N%)
                VDatos(N).Titulo = FileArch.List(N - 1)
                VDatos(N).Path = FileArch.List(N - 1)
                VDatos(N).Accion = "C"
            Next N
            N = N - 1
    End Select
    Prim% = 1
    CDat = N%
    VCat(WCual).Cant = CDat
    A_DAT = 1
    LblTit.Caption = VCat(WCual).Titulo + ": " + Str$(VCat(WCual).Cant) + " progs."
    LblTit.Refresh
    LblDesc.Caption = VCat(WCual).Desc
    LblDesc.Refresh
    PicDat.Refresh
    Accion A_DAT
End Sub
Sub categoria_Click (Index As Integer)
    CateOff
    CatActual = Index
    CargaDat CatActual
    PicDat.Refresh
End Sub
Sub CateOff ()
    Dim X%
    For X = 0 To CANTCAT
        Categoria(X).ForeColor = C_Norm
        Categoria(X).BorderStyle = 0
    Next X
End Sub
Sub Form_Load ()
    Dim Wtit$, Wpara$, L%
    Wpath = FWPath()
    C_Norm = QBColor(8)
    C_Hlite = QBColor(1)
    LblTit.ForeColor = C_Hlite
    PicPres.Picture = LoadPicture(Wpath + "pres.bmp")
    PicPrin.Picture = LoadPicture(Wpath + "fondo.bmp")
    CenterSize PicPrin
    CenterSize PicPres
    PicPres.Visible = True
    PicPres.Refresh
    PlaySnd (Wpath + "Fanfarri.wav")
    CateOff
    PicDat.BorderStyle = 0
    PicDesc.BorderStyle = 0
    CopiaFon PicPrin, PicDat
    CopiaFon PicPrin, PicDesc
    Alinear BotTriD, BotTriU
    Alinear BotInstD, BotInst
    Alinear BotCopD, BotCop
    Alinear BotExeD, BotExe
    XI = ImgFoto.Left
    YI = ImgFoto.Top
    ANI = ImgFoto.Width
    ALI = ImgFoto.Height
    'Cambiar aca para que lea las categorias del disco
    If Not True Then
        'Una sola categoria
        CANTCAT = 0
        ReDim VCat(1)
        'Aca va el nombre del DAT
        VCat(0).DAT = "fonts"
        VCat(0).Titulo = "Fonts"
    Else
        CargaCat
        CateOff
    End If
    CLIN = 9
    CargaDat 0
    CatActual = 0
End Sub
Sub PiCDat_Click ()
    Dim N%, EX$
    Dim CurPos As PointApi
    Dim X As Integer
    Dim T As Integer
    T = 0
    GETCURSORPOS CurPos
    CurPos.y = CurPos.y - PicDat.Top - PicPrin.Top - FrmMain.Top / screen.TwipsPerPixelY
    For X = Prim To Prim + CLIN
        If X > CDat Then
            Exit For
        End If
        If CurPos.y < VDatos(X).Bottom Then
            T = X
            X = CDat
        End If
    Next X
    If T <> 0 Then
        A_DAT = T
        PicDat.Refresh
        Accion T
    End If
End Sub
Sub PiCDat_Paint ()
    Dim Col As Long
    screen.MousePointer = 0
    PicDat.ForeColor = C_Norm
    Dim X As Integer
    Dim y As Integer
    PicDat.ForeColor = C_Norm
    PicDat.Cls
    For X = Prim To Prim + CLIN
        If X > CDat Then
            Exit For
        End If
        If X = A_DAT Then
            Col = C_Hlite
        Else
            Col = C_Norm
        End If
        On Error Resume Next
        PrCenter VDatos(X).Titulo, PicDat, X - Prim + 1, Col
        VDatos(X).Bottom = PicDat.CurrentY - 1
        On Error GoTo 0
    Next X
    BotInst.Visible = False
    BotCop.Visible = False
    BotExe.Visible = False
    L = Len(VDatos(A_DAT).Accion)
    For X = 1 To L
        C = UCase$(Mid$(VDatos(A_DAT).Accion, X, 1))
        Select Case C
            Case "I"
                BotInst.Visible = True
            Case "C"
                BotCop.Visible = True
            Case "E"
                BotExe.Visible = True
        End Select
    Next X
End Sub
Sub PicDesc_Paint ()
    PicDesc.ForeColor = C_Norm
    Accion A_DAT
End Sub
Sub PicPres_Click ()
    PicPres.Visible = False
    PicPrin.Visible = True
    PicPrin.Refresh
    PicPres.Picture = LoadPicture()
End Sub